open StdLabels

let abrLex = new Arbre_lexical.abrLex

let toplevel = ref [""]

type data = {
  col_text : string GTree.column;     
  list_store : GTree.list_store;               (* List store.          *)
}

type area = {
  frame : GObj.widget;                    (* Popup frame.         *)
  scroll : GBin.scrolled_window;
  tree_view : GTree.view;
}

type t = { 
  data : data;
  area : area;
  vcol : GTree.view_column;
  source : GSourceView2.source_view;
  buffer : GSourceView2.source_buffer
}

(* Some getters to hide the implementation in the code below. *)

let col_text t = t.data.col_text
let source t = t.source
let buffer t = t.buffer
let frame t = t.area.frame
let scroll t = t.area.scroll
let tree_view t = t.area.tree_view
let list_store t = t.data.list_store
let view_col t = t.vcol

module Popup =
  struct
    (* Show popup *)
    let show =
      fun t (x, y) ->
        let child = frame t in
        (source t)#move_child ~child ~x ~y;
        child#misc#show ()
    (* Hide popup and clear contents.*) 
    let hide t _ =
        (frame t)#misc#hide (); 
      false
  end

let cols = new GTree.column_list
let name = cols#add Gobject.Data.string

let create_store () =
    let list_store = GTree.list_store cols in 
    List.iter !toplevel ~f:
    begin fun n ->
      let row = list_store#append () in
      list_store#set ~row ~column:name n;
   end;
  list_store

let failure n fmt =
  Printf.ksprintf (fun msg ->
    Printf.eprintf "%s.\n%!" msg;
    exit n
  ) ("(Aurora) Error: " ^^ fmt)

(* Get selected iter. *)
let get_selected_iter t =
  match (tree_view t)#selection#get_selected_rows with
  | path :: _ -> (list_store t)#get_iter path
  | [] -> 
    match (list_store t)#get_iter_first with
    | Some iter -> iter
    | _ -> failure 8 "empty"



let add_columns ~(view : GTree.view) =
  let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
  let vc =
    GTree.view_column ~renderer:(renderer, ["text", name]) ()
  in
  view#append_column vc

(* Try to determine the best popup coordinates. *)
let best_coord t =
  let r1 = (source t)#get_iter_location ((buffer t)#get_iter `INSERT)
  and r2 = (source t)#visible_rect in
  if Gdk.Rectangle.width r2 > 300 && Gdk.Rectangle.height r2 > 100 then (
    let x = Gdk.Rectangle.x r1 - Gdk.Rectangle.x r2 
    and y = Gdk.Rectangle.y r1 - Gdk.Rectangle.y r2 + 14 in
    Some ((x - if x + 280 >= Gdk.Rectangle.width  r2 then 280 else 0),
    (y - if y + 100 >= Gdk.Rectangle.height r2 then 114 else 0))
  ) else None

(* show popup. *)
let word = ref ""
let replace = ref ""


let check_input t= 
   let stop = (buffer t)#get_iter `INSERT in
    if stop#ends_word 
    then 
     (
      let start = stop#backward_word_start#backward_char in
      word := (buffer t)#get_text ~start ~stop ();
      (
       if((String.get !word 0) = ' ') 
       then word := String.sub !word 1 ((String.length !word)-1)
      );
      if((List.length !toplevel) <> 0) 
      then(Gaux.may (Popup.show t) (best_coord t))
     ) 
    else if (frame t)#misc#visible then ignore (Popup.hide t ())

(* hide popup. *)

let finalize t _ =
  let row = get_selected_iter t in
  let stop = (buffer t)#get_iter `INSERT in
  let start = stop#backward_word_start#backward_char in
  (buffer t)#delete ~start ~stop;
  replace := " "^(list_store t)#get ~row ~column:name; 
  (buffer t)#insert !replace;
  Popup.hide t ()


let add_word word t=
      let row = (list_store t)#append () in
      (list_store t)#set ~row ~column:name word


let addArbreLex t =
    (list_store t)#clear ();
    let arbre = abrLex#construit (((source t)#buffer#get_text ())) in
    toplevel := abrLex#get_list !word arbre;
    List.iter (fun e -> add_word e t) !toplevel
 
(* Choose action when a key is pressed. *)
let select_action t ev =
    addArbreLex t;
    if ((List.length !toplevel <> 0) && (frame t)#misc#visible) then (
    let here = (list_store t)#get_path (get_selected_iter t) in
    match GdkEvent.Key.keyval ev with
      | 0xFF52 (* Up arrow *) -> let _ = GTree.Path.prev here in
      let _ = (tree_view t)#set_cursor here (view_col t) in true
      | 0xFF54 (* Down arrow *) ->let _ = GTree.Path.next here in
      let _ = (tree_view t)#set_cursor here (view_col t) in 
      let _ = GTree.Path.next here in true
      | 0xFF0D | 0xFF8D (* Entry *) -> not (finalize t ())
      | 0xFF1B | 0xFF08 | 0xFF9A | 0xFF9B | 0xFF95
      | 0xFF96 | 0xFF98 | 0xFF51 | 0xFF53 -> Popup.hide t ()
      | _ -> false
  ) else false

  (* Tree view data. *)
let get_data () =
  let cols = new GTree.column_list in
  let col_text = cols#add Gobject.Data.string in
  let store = create_store () in
  {col_text = col_text;  list_store = store }

(* Tree view cell renderers and columns. *)
let get_view data =
    let cell_text = GTree.cell_renderer_text [`XPAD 5] in
  let vcol = GTree.view_column () in
  vcol#pack cell_text;
  vcol#add_attribute cell_text "markup" data.col_text;
  vcol

let get_area data vcol =
    let scroll = GBin.scrolled_window 
      ~width:250 ~height:150 
       ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
      ~vpolicy:`AUTOMATIC ~show:false () in
     let view = GTree.view 
      ~model:data.list_store
      ~headers_visible:false
      ~rules_hint:true 
      ~packing:scroll#add () in
     let _ = view#append_column vcol in
     let _ = view#set_hover_selection true in
    { frame = scroll#coerce; scroll = scroll; tree_view = view }


(* Main function. *)
let add (source : GSourceView2.source_view) =
  let data = get_data () in
  let vcol = get_view data in
  let area = get_area data vcol in
  source#add_child_in_window ~child:area.frame ~which_window:`TEXT ~x:0 ~y:0;
  let buffer = source#source_buffer in
  let t = { data = data; vcol = vcol; area = area; source = source; buffer = buffer } in
 (* let _ = (tree_view t)#connect#row_activated ~callback:
      (on_row_activated t (tree_view t)) in*)
  let _ = buffer#connect#changed (fun () -> check_input t) in
  let _ = (tree_view t)#event#connect#button_release (finalize t) in
  let connect = source#event#connect in
  let _ = connect#key_press (select_action t) in
  let _ = connect#button_press (Popup.hide t) in
  let _ =connect#scroll (Popup.hide t) in
   () 

